home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Memphis Amiga Group / MAG Disk (1989-11)(Memphis Amiga Group).zip / MAG Disk (1989-11)(Memphis Amiga Group).adf / Guru / guru.f < prev    next >
Text File  |  1986-11-06  |  8KB  |  324 lines
  1. \ Decode GURU numbers ... Mike Haas, ... Nov. 27, 1987
  2.  
  3. include? clone         gu:CloneNames
  4.  
  5.  
  6. ANEW Task-GURU.f
  7.  
  8.  
  9. decimal
  10.  
  11.  
  12. variable digit1        variable Invalid
  13. variable general       variable SubSystem
  14. variable specific
  15.  
  16.  
  17. : color1   $ 9b emit  ." 31m" flushemit ;
  18.  
  19. : color3   $ 9b emit  ." 33m" flushemit ;
  20.  
  21.  
  22. : Number?+  ( $string -- d1 true / false )
  23. \
  24. \ same as NUMBER? but 0-len string returns FALSE
  25. \
  26.   dup count upper
  27.   dup c@ 1 max over c!   Number?
  28. ;
  29.  
  30.  
  31. : ParseNumber   ( -- n1 true / false )
  32.   invalid @ 0=
  33.   IF
  34.      bl word   ( -- adrcnt )  number?+
  35.      IF
  36.         ( -- d1 )
  37.         IF
  38.            \ number is too big...
  39.            invalid on
  40.         THEN
  41.      ELSE
  42.         \ string is not a number...
  43.         invalid on
  44.      THEN
  45.   THEN
  46.   invalid @ 0=
  47. ;
  48.  
  49. : .COMMAND  ( -- )
  50.   >in @   >in off  bl word  $type  >in !
  51. ;
  52.  
  53. : .HELP
  54.   cr  ." Usage:  "  .command ."  <GuruNumber>"   cr
  55.   cr  ." 'GuruNumber' is the unsigned, 32-bit hex number"
  56.   cr  ." that appears leftmost in the guru alert." cr
  57. ;
  58.  
  59.  
  60. : .TYPE       color1  ."     Alert Type: "  color3   ;
  61. : .SUBSYSTEM  color1  ."   Generated by: "  color3   ;
  62. : .GENERAL    color1  ."  General Cause: "  color3   ;
  63. : .SPECIFIC   color1  ." Specific Cause: "  color3   ;
  64.  
  65.  
  66. : "LIB   ."  Library"  ;
  67. : "DEV   ."  Device"   ;
  68. : "RES   ."  Resource" ;
  69. : "ERR   ."  error"    ;
  70. : "MEM   ." , no memory" ;
  71.  
  72.  
  73. : ID.SUBSYSTEM  ( system -- )
  74.   CASE
  75.     $ 01 OF  ." Exec"       "lib   ENDOF
  76.     $ 02 OF  ." Graphics"   "lib   ENDOF
  77.     $ 03 OF  ." Layers"     "lib   ENDOF
  78.     $ 04 OF  ." Intuition"  "lib   ENDOF
  79.     $ 05 OF  ." Math"       "lib   ENDOF
  80.     $ 06 OF  ." Clist"      "lib   ENDOF
  81.     $ 07 OF  ." DOS"        "lib   ENDOF
  82.     $ 08 OF  ." RAM"        "lib   ENDOF
  83.     $ 09 OF  ." Icon"       "lib   ENDOF
  84.     $ 0a OF  ." Expansion"  "lib   ENDOF
  85.     $ 10 OF  ." Audio"      "dev   ENDOF
  86.     $ 11 OF  ." Console"    "dev   ENDOF
  87.     $ 12 OF  ." GamePort"   "dev   ENDOF
  88.     $ 13 OF  ." Keyboard"   "dev   ENDOF
  89.     $ 14 OF  ." TrackDisk"  "dev   ENDOF
  90.     $ 15 OF  ." Timer"      "dev   ENDOF
  91.     $ 20 OF  ." CIA"        "res   ENDOF
  92.     $ 21 OF  ." Disk"       "res   ENDOF
  93.     $ 22 OF  ." Misc"       "res   ENDOF
  94.     $ 30 OF  ." BootStrap"         ENDOF
  95.     $ 31 OF  ." Workbench"         ENDOF
  96.     $ 32 OF  ." DiskCopy"          ENDOF
  97.   ENDCASE
  98. ;
  99.  
  100.  
  101. : ID.GENERAL  ( gen -- )
  102.   CASE
  103.     $ 01 OF  ." Insufficient memory"   ENDOF
  104.     $ 02 OF  ." MakeLibrary"  "err     ENDOF
  105.     $ 03 OF  ." OpenLibrary"  "err     ENDOF
  106.     $ 04 OF  ." OpenDevice"   "err     ENDOF
  107.     $ 05 OF  ." OpenResource" "err     ENDOF
  108.     $ 06 OF  ." I/O"          "err     ENDOF
  109.     $ 07 OF  ." NoSignal"              ENDOF
  110.   ENDCASE
  111. ;
  112.  
  113.  
  114. : ID.Exec    ( -- )
  115.   Specific @
  116.   CASE
  117.     $ 01 OF  ." 68000 exception vector checksum"      ENDOF
  118.     $ 02 OF  ." ExecBase checksum"                    ENDOF
  119.     $ 03 OF  ." Library checksum"                     ENDOF
  120.     $ 04 OF  ." No memory to make library"            ENDOF
  121.     $ 05 OF  ." Corrupted memory list"                ENDOF
  122.     $ 06 OF  ." No memory for interrupt servers"      ENDOF
  123.     $ 07 OF  ." InitStruct() of an APTR source"       ENDOF
  124.     $ 08 OF  ." A semaphore is in an illegal state"   ENDOF
  125.     $ 09 OF  ." Freeing memory that is already free"  ENDOF
  126.     $ 0a OF  ." Illegal 68000 exception taken"        ENDOF
  127.   ENDCASE
  128. ;
  129.  
  130.  
  131. : ID.Graphics    ( -- )
  132.   Specific @
  133.   CASE
  134.     $ 06 OF  ." Long frame" "mem                 ENDOF
  135.     $ 07 OF  ." Short frame" "mem                ENDOF
  136.     $ 09 OF  ." Text, no memory for TempRas"     ENDOF
  137.     $ 0a OF  ." BltBitMap" "mem                  ENDOF
  138.     $ 0b OF  ." Regions" "mem                    ENDOF
  139.     $ 30 OF  ." MakeVPort" "mem                  ENDOF
  140.   $ 1234 OF  ." Emergency memory not available"  ENDOF
  141.   ENDCASE
  142. ;
  143.  
  144.  
  145. : ID.Intuition    ( -- )
  146.   Specific @
  147.   CASE
  148.     $ 01 OF  ." Unknown gadget type"                  ENDOF
  149.     $ 02 OF  ." CreatePort()" "mem                    ENDOF
  150.     $ 03 OF  ." Item plane alloc" "mem                ENDOF
  151.     $ 04 OF  ." Sub alloc" "mem                       ENDOF
  152.     $ 05 OF  ." Plane alloc" "mem                     ENDOF
  153.     $ 06 OF  ." Item box top < relative zero"         ENDOF
  154.     $ 07 OF  ." Open screen" "mem                     ENDOF
  155.     $ 08 OF  ." Open screen, raster alloc" "mem       ENDOF
  156.     $ 09 OF  ." Open sys screen, unknown type"        ENDOF
  157.     $ 0a OF  ." Add SW gadgets" "mem                  ENDOF
  158.     $ 0b OF  ." Open window" "mem                     ENDOF
  159.     $ 0c OF  ." Bad state return entering Intuition"  ENDOF
  160.     $ 0d OF  ." Bad message received by IDCMP"        ENDOF
  161.     $ 0e OF  ." Wierd echo causing incomprehension"   ENDOF
  162.     $ 0f OF  ." Couldn't open the Console Device"     ENDOF
  163.   ENDCASE
  164. ;
  165.  
  166.  
  167. : ID.DOS    ( -- )
  168.   Specific @
  169.   CASE
  170.     $ 01 OF  ." No memory at startup"        ENDOF
  171.     $ 02 OF  ." EndTask() didn't"            ENDOF
  172.     $ 03 OF  ." Qpkt failure"                ENDOF
  173.     $ 04 OF  ." Unexpected packet received"  ENDOF
  174.     $ 05 OF  ." Freevec failed"              ENDOF
  175.     $ 06 OF  ." Disk block sequence error"   ENDOF
  176.     $ 07 OF  ." Bitmap corrupt"              ENDOF
  177.     $ 08 OF  ." Key already free"            ENDOF
  178.     $ 09 OF  ." Invalid checksum"            ENDOF
  179.     $ 0a OF  ." Disk error"                  ENDOF
  180.     $ 0b OF  ." Key out of range"            ENDOF
  181.     $ 0c OF  ." Bad overlay"                 ENDOF
  182.   ENDCASE
  183. ;
  184.  
  185.  
  186. : ID.RAM    ( -- )
  187.   Specific @
  188.   CASE
  189.     $ 01 OF  ." Overlays illegal for library segments"  ENDOF
  190.   ENDCASE
  191. ;
  192.  
  193.  
  194. : ID.Expansion    ( -- )
  195.   Specific @
  196.   CASE
  197.     $ 01 OF  ." Bad expansion free"  ENDOF
  198.   ENDCASE
  199. ;
  200.  
  201.  
  202. : ID.TrackDisk    ( -- )
  203.   Specific @
  204.   CASE
  205.     $ 01 OF  ." Calibration seek error"  ENDOF
  206.     $ 02 OF  ." Delay error on timer wait"  ENDOF
  207.   ENDCASE
  208. ;
  209.  
  210.  
  211. : ID.Timer    ( -- )
  212.   Specific @
  213.   CASE
  214.     $ 01 OF  ." Bad request"  ENDOF
  215.     $ 02 OF  ." Power supply not supplying ticks"  ENDOF
  216.   ENDCASE
  217. ;
  218.  
  219.  
  220. : ID.Disk    ( -- )
  221.   Specific @
  222.   CASE
  223.     $ 01 OF  ." Get unit: already has disk"  ENDOF
  224.     $ 02 OF  ." Interrupt: no active unit"  ENDOF
  225.   ENDCASE
  226. ;
  227.  
  228.  
  229. : ID.BootStrap    ( -- )
  230.   Specific @
  231.   CASE
  232.     $ 01 OF  ." Boot code returned an error"  ENDOF
  233.   ENDCASE
  234. ;
  235.  
  236.  
  237. : ID.SPECIFIC  ( -- )
  238.   SubSystem @
  239.   CASE
  240.     $ 01 OF  ID.Exec          ENDOF
  241.     $ 02 OF  ID.Graphics      ENDOF
  242.     $ 04 OF  ID.Intuition     ENDOF
  243.     $ 07 OF  ID.DOS           ENDOF
  244.     $ 08 OF  ID.RAM           ENDOF
  245.     $ 14 OF  ID.TrackDisk     ENDOF
  246.     $ 15 OF  ID.Timer         ENDOF
  247.     $ 21 OF  ID.Disk          ENDOF
  248.     $ 30 OF  ID.BootStrap     ENDOF
  249.   ENDCASE
  250. ;
  251.  
  252.  
  253. : AnalyzeSystem  ( -- )
  254.   digit1 @
  255. \
  256.   dup $ 8000,0000 and  .TYPE
  257.   IF  ." DEADEND"  ELSE ." RECOVERABLE"  THEN  cr
  258. \ 
  259.   .SubSystem  SubSystem @  ID.Subsystem  cr
  260. \
  261.   ( -- digit1 )  dup $ ff,0000 and  16 -shift  ?dup
  262.   IF
  263.      .GENERAL  ID.General  cr
  264.   THEN
  265. \
  266.   ( -- digit1 )  $ ffff and  ?dup
  267.   IF
  268.      .SPECIFIC  specific !  ID.Specific  cr
  269.   THEN
  270. \
  271. ;
  272.  
  273.  
  274. : AnalyzeTrap  ( -- )
  275.   .TYPE   ." 68000 Trap" cr
  276.   .GENERAL  digit1 @
  277.   CASE
  278.     $ 02 OF  ." Bus error"  ENDOF
  279.     $ 03 OF  ." Address error"  ENDOF
  280.     $ 04 OF  ." Illegal instruction"  ENDOF
  281.     $ 05 OF  ." Divide by zero"  ENDOF
  282.     $ 06 OF  ." CHK instruction"  ENDOF
  283.     $ 07 OF  ." TRAPV (Overflow)"  ENDOF
  284.     $ 08 OF  ." Priviledge violation"  ENDOF
  285.     $ 09 OF  ." Instruction trace"  ENDOF
  286.     $ 0a OF  ." Line A emulation"  ENDOF
  287.     $ 0b OF  ." Line F emulation"  ENDOF
  288.              ." User trap"
  289.   ENDCASE cr
  290. ;
  291.  
  292.  
  293. : AnalyzeGuru  ( -- )
  294.   color1
  295.   digit1 @  $ 7f00,0000 and  24 -shift  dup SubSystem !
  296.   IF
  297.      AnalyzeSystem
  298.   ELSE
  299.      AnalyzeTrap
  300.   THEN
  301. ;
  302.  
  303.  
  304. : Guru   ( -- , <xxxx yyyy> OR <xxxx.yyyy> )
  305.   >newline  .command ."  1.0 by Mike Haas, written in JForth" cr
  306.   invalid off  hex ParseNumber
  307.   IF
  308.      digit1 !
  309.   THEN
  310.   \
  311.   Invalid @
  312.   IF
  313.      here w@ $ 013f -
  314.      IF
  315.         cr ." Error in argument: "  here $type  cr
  316.      THEN
  317.      .help
  318.   ELSE
  319.      AnalyzeGuru
  320.   THEN
  321.   color1
  322. ;
  323.  
  324.